home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / window40.zip / WNDWDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1987-12-12  |  23KB  |  679 lines
  1. { =========================================================================== }
  2. { WndwDemo.pas - Multi-level window demo for WNDW40.TPU     ver 4.0, 12-12-87 }
  3. {                                                                             }
  4. { This program shows you some of basic window utilities.  It only shows       }
  5. { access any window at any time.  You can even hide the top level window for  }
  6. { displaying later.                                                           }
  7. { =========================================================================== }
  8.  
  9. program WindowDemo;
  10.  
  11. {$M 16384, 22000, 22000 }
  12. {$R-,S-,I+,D-,T-,F-,V-,B-,N-,L+ }
  13.  
  14. uses Crt,Qwik,WndwVars,Wndw;
  15.  
  16. type
  17.   Str80 = string[80];
  18.   Steps = (Step0,Step1,Step2,Step3,Step3b,Step3c,Step4,Step5,Step5b,Step6,
  19.            Step7,Step8,Step9,Step9b,Step9c,Step11,Step12,Step13,Step14,
  20.            Step15,Step16,Step17);
  21.  
  22. var
  23.   Step:              Steps;
  24.   i,j,k,m,OldCursor: word;
  25.   Battr,Wattr:       integer;
  26.   Key:               char;
  27.  
  28. const
  29.   FuncKey = #00;
  30.   RetKey = #13;
  31.   EscKey = #27;
  32.   StrA : array [1..17] of Str80 = (
  33.     'The  windowing  utilities in the  file  WNDW40.ARC',
  34.     'combined  with QWIK40.ARC are  ShareWare  routines',
  35.     'that  allow Turbo Pascal 4.0 to create  incredibly',
  36.     'fast  multi-level random-access windows.   Here is',
  37.     'the kind of windows you can create:',
  38.     '',
  39.     '  Size:        2x2 to screen limits',
  40.     '  Colors:      256 for window and/or border',
  41.     '  Borders:     12 styles, 2 custom, or no border',
  42.     '  Partitions:  Horizontal, vertical and cross',
  43.     '  Column mode: 40/80/variable',
  44.     '  Text modes:  All (0..3, 7)',
  45.     '',
  46.     'These windows  can be accessed at any level, shuf-',
  47.     'fled around, or even moved by the end user.  These',
  48.     'utilities automatically  configure  to  your video',
  49.     'card(s) and mode for the greatest speed.');
  50.  
  51.   StrB : array [1..11] of Str80 = (
  52.     'WNW40.ARC consists of fourteen utilities:',
  53.     '',
  54.     '      InitWindow       TitleWindow',
  55.     '      SetWindowModes   ClearTitle',
  56.     '      MakeWindow       ClearWindow',
  57.     '      PartitionWindow  HideWindow',
  58.     '      PartitionCross   ShowWindow',
  59.     '      ScrollWindow     MoveWindow',
  60.     '      RemoveWindow     AccessWindow',
  61.     '',
  62.     'and are described in the following windows:');
  63.  
  64.   StrC : array [1..6] of Str80 = (
  65.     'FORMAT:  InitWindow (WindowAttr: byte, ClearScr: boolean);',
  66.     '',
  67.     'InitWindow initializes 24 variables needed by the utilities.',
  68.     'You can select  the foreground and  background colors of the',
  69.     'initial screen display with the option  to clear the screen.',
  70.     'InitWindow must be called before using any other procedures.');
  71.  
  72.   StrC1 : array [1..12] of Str80 = (
  73.     'FORMAT:  SetWindowModes (SumOfAllModes: byte);',
  74.     '',
  75.     'SetWindowModes is any easy way to set the following window mode',
  76.     'constants saved in the global variable WindowModes:',
  77.     '',
  78.     '  PermMode    = $01 - Can''t be moved or removed; no underlay',
  79.     '  FixedMode   = $02 - Can''t be moved or accessed',
  80.     '  ShadowLeft  = $04 - Shadow on the left side',
  81.     '  ShadowRight = $08 - Shadow on the right side',
  82.     '  ZoomMode    = $10 - Zoom effect on Make and AccessWindow',
  83.     '',
  84.     'WindowModes is maintained for subsequent windows until changed.');
  85.  
  86.   StrC2: array [1..9] of Str80 = (
  87.     'CGA:',
  88.     'The CGA is self-regulating and controls the',
  89.     'zoom rate.',
  90.     'MDA, EGA, MCGA, VGA, Hercules, and others:',
  91.     'These video cards are  quite fast and need a',
  92.     'delay for the effect.  A default value of 12',
  93.     'or 18 milliseconds  is  used in "ZoomDelay",',
  94.     'the  latter is  used on  faster 80286/80386',
  95.     'machines.');
  96.  
  97.   StrD1 : array [1..16] of Str80 = (
  98.     'FORMAT:  MakeWindow (Row,Col,Rows,Cols: byte; Wattr,Battr: integer;',
  99.     '                     BrdrSel: Borders; WindowName: WindowNames);',
  100.     '',
  101.     'MakeWindow  creates a new blank  window  starting at  (row,col)  and',
  102.     'extending for a number of rows and columns (rows,cols).  If a border',
  103.     'exists, the Turbo window will  be shrunk within the borders.  A name',
  104.     'serves as an ID for random access.  The border can be any one of the',
  105.     'following:',
  106.     '',
  107.     '  NoBrdr      - just window     EvenSolidBrdr  - evenly solid',
  108.     '  BlankBrdr   - blank spaces    ThinSolidBrdr1 - thin solid line',
  109.     '  SingleBrdr  - single line     ThinSolidBrdr2 - thin solid line',
  110.     '  DoubleBrdr  - double line     LhatchBrdr  - light hatch',
  111.     '  HdoubleBrdr - horiz double    MhatchBrdr  - medium hatch',
  112.     '  VdoubleBrdr - vert double     HhatchBrdr  - heavy hatch',
  113.     '  SolidBrdr   - solid           UserBrdr1/2 - user defined borders');
  114.  
  115.   StrD2 : array [1..6] of Str80 = (
  116.     'FORMAT:  PartitionWindow (Direction: DirType; RowOrCol: byte);',
  117.     '         PartitionCross  (WindowRow,WindowCol: byte);',
  118.     'Partitions can be made inside any window with a border as shown.',
  119.     'Simply specify the direction (Horiz/Vertical) and the location',
  120.     'relative to the Turbo window.  A PartitionCross is needed where',
  121.     'both the vertcial and horizontal intersect.');
  122.  
  123.   StrE : array [1..4] of Str80 = (
  124.     'FORMAT:   RemoveWindow;',
  125.     'RemoveWindow removes the top level',
  126.     'window  from  the screen  and also',
  127.     'from memory.');
  128.  
  129.   StrF : array [1..2] of Str80 = (
  130.     'See if your BIOS gives you flicker',
  131.     'when your screen rolls down next ...');
  132.  
  133.   StrG : array [1..16] of Str80 = (
  134.     '',
  135.     'FORMAT:  ScrollWindow (RowBegin,RowEnd: byte; Dir: DirType);',
  136.     '',
  137.     'Turbo''s standard procedures  InsLine and DelLine may have worked just',
  138.     'fine this window.  However, if  your screen just had some bad flicker',
  139.     'as it was scrolling down, your  BIOS is not flicker-free. To keep the',
  140.     'display flicker-free, to work on other video pages, VGA, or EGA, then',
  141.     'you will need this procedure.   The upward  scroll used ScrollWindow,',
  142.     'so no flicker was seen then.  It also scrolls partial windows.',
  143.     '',
  144.     'The direction of scroll can be either of the following:',
  145.     '',
  146.     '    ''Up''   - to scroll up',
  147.     '    ''Down'' - to scroll down',
  148.     '',
  149.     '');
  150.  
  151.   StrH : array [1..5] of Str80 = (
  152.     'FORMAT:  TitleWindow (TopOrBottom,Justify: DirType;',
  153.     '                      Title: string);',
  154.     'TitleWindow  places  a title  in  the top  or bottom',
  155.     'border of the current window.  Justify permits Left,',
  156.     'Center, or Right justification of the title.');
  157.  
  158.   StrH2 : array [1..3] of Str80 = (
  159.     'FORMAT:  ClearTitle (TopOrBottom: DirType);',
  160.     'ClearTitle clears  the entire top or bottom',
  161.     'border of a title by restoring the border.');
  162.  
  163.   StrH3 : array [1..4] of Str80 = (
  164.     'FORMAT:  ClearWindow;',
  165.     'ClearWindow works just',
  166.     'like ClrScr,  but also',
  167.     'on any video page.');
  168.  
  169.   StrJ : array [1..5] of Str80 = (
  170.     'The maximum  number  of windows that',
  171.     'may be on the screen at any one time',
  172.     'is   specified   by   the   constant',
  173.     '"MaxWndw".   Assign  it in  the unit',
  174.     'called WNDWVARS.PAS.');
  175.  
  176.   StrK : array [1..10] of Str80 = (
  177.     'In addition to windows, there are 17 powerful',
  178.     'QWIK screen write procedures you can use:',
  179.     '    Qwrite    QfillC        GotoRC',
  180.     '    QwriteC   Qfill         CursorChange',
  181.     '    QwriteA   QstoreToMem   CursorOn',
  182.     '    Qattr     QstoreToScr   CursorOff',
  183.     '    QattrC    QviewPage     WhereR',
  184.     '              QwritePage    WhereC',
  185.     'In QWIK40.ARC, compile and run QWIKDEMO.PAS to',
  186.     ' see all of the features.');
  187.  
  188.   StrL : array [1..20] of Str80 = (
  189.     'The procedures are used as follows:',
  190.     '',
  191.     ' program YourProgram;',
  192.     ' uses Qwik,Crt,WndwVars,Wndw;',
  193.     ' ...Your variables and procedures...',
  194.     ' begin',
  195.     '   InitWindow (WindowAttr,ClearScr);',
  196.     '   SetWindowModes (SumOfAllModes);',
  197.     '   MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,',
  198.     '               BrdrSelection,WindowName);',
  199.     '   PartitionWindow (Direction,WindowRowOrCol);',
  200.     '   PartitionCross  (WindowRow,WindowCol);',
  201.     '   TitleWindow (TopOrBottom,Justify,''Title'');',
  202.     '   ...',
  203.     '   MoveWindow  (Direction,NumOfChars);',
  204.     '   AccessWindow (WindowName);',
  205.     '   RemoveWindow;',
  206.     ' end.',
  207.     '',
  208.     '{ Use one RemoveWindow for each MakeWindow. }');
  209.  
  210.   StrM : array [1..15] of Str80 = (
  211.     'WNDW40.TPU works these ...',
  212.     '',
  213.     'COMPUTERS:           ADAPTERS:',
  214.     '------------------   ---------',
  215.     'IBM PC               MDA',
  216.     'IBM XT               CGA',
  217.     'IBM AT               EGA',
  218.     'IBM PCjr             MCGA',
  219.     'IBM PC Convertible   VGA',
  220.     'IBM PS/2 Model 25    8514/A',
  221.     'IBM PS/2 Model 30    Hercules:',
  222.     'IBM PS/2 Model 50     HGC',
  223.     'IBM PS/2 Model 60     HGC Plus',
  224.     'IBM PS/2 Model 80     InColor',
  225.     'IBM 3270 PC');
  226.  
  227.   StrN : array [1..9] of Str80 = (
  228.     'This demo was for serial access.',
  229.     'For the random-access demo of:',
  230.     '',
  231.     '       HideWindow',
  232.     '       ShowWindow',
  233.     '       MoveWindow',
  234.     '       AccessWindow',
  235.     '',
  236.     'run WMGRDEMO.PAS.');
  237.  
  238.   StrO : array [1..7] of Str80 = (
  239.     'If you have any questions or comments,',
  240.     'please write to or call:',
  241.     '',
  242.     '   Jim H. LeMay  (CIS 76011,217)',
  243.     '   6341 Klamath Rd.',
  244.     '   Ft. Worth, TX  76116',
  245.     '   1-(817)-735-4833 (after 1730 CST)');
  246.  
  247. procedure Display30windows;
  248. begin
  249.   { -- Throw out 30 windows 4 times -- }
  250.   randomize;
  251.   for m:=1 to 4 do
  252.     begin
  253.       for i:=1 to 30 do
  254.         begin
  255.           j := random (60);
  256.           k := random (20);
  257.           TextAttr:=yellow+GreenBG;
  258.           MakeWindow (k+1,j+1,6,21,black+GreenBG,TextAttr,DoubleBrdr,
  259.                       aWindow);
  260.           with TopWndwStat do
  261.             begin
  262.               QwriteC (WSrow+2,WScol,WScol2, -1,'Random-Access');
  263.               QwriteC (WSrow+3,WScol,WScol2, -1,'WINDOWS');
  264.             end;
  265.         end;
  266.         if m=4 then
  267.              delay (1500)
  268.         else delay ( 300);
  269.         for i:=LI downto 1 do
  270.           RemoveWindow;
  271.      end
  272. end;
  273.  
  274. procedure DisplayInitialScreen;
  275. begin
  276.   { -- Create initial screen -- }
  277.   QwriteC ( 1, 1,CRTcols, -1,'Turbo PASCAL Windows Tutorial');
  278.   QwriteC ( 2, 1,CRTcols, -1,'Version 4.0');
  279.   TextColor (black);
  280.   QwriteC ( 4, 1,CRTcols,TextAttr,'For each of the following displays:');
  281.   Qwrite  ( 5,26   ,TextAttr,'1. Press RETURN to continue.');
  282.   Qwrite  ( 6,26   ,TextAttr,'2. Press ESC to back up.');
  283.   QwriteC (12, 1,CRTcols,TextAttr,
  284.            'This is the original screen without windows.');
  285.   Step:=Step0;
  286. end;
  287.  
  288. procedure DisplayGeneral;
  289. begin
  290.   { -- General description -- }
  291.   SetWindowModes (ShadowRight);
  292.   MakeWindow (4,15,19,52,black+GreenBG,black+GreenBG,HdoubleBrdr,aWindow);
  293.   TitleWindow (Top,Center,' Turbo Pascal 4.0 Windows ');
  294.   with TopWndwStat do
  295.     begin
  296.       for j:= 1 to  6 do Qwrite (WSrow+j,WScol+1,            -1,StrA[j]);
  297.       for j:= 7 to 12 do Qwrite (WSrow+j,WScol+1,yellow+GreenBG,StrA[j]);
  298.       for j:=13 to 17 do Qwrite (WSrow+j,WScol+1,            -1,StrA[j]);
  299.     end;
  300. end;
  301.  
  302. procedure DisplayList;
  303. begin
  304.   { -- List of Procedures -- }
  305.   SetWindowModes (0);
  306.   MakeWindow (5,2,15,47,black+CyanBG,white+BlueBG,MhatchBrdr,aWindow);
  307.   TitleWindow (Top,Center,' Fourteen Utilities ');
  308.   with TopWndwStat do
  309.   begin
  310.                        Qwrite (WSrow+2  ,WScol+2,          -1,StrB[ 1]);
  311.     for j:=2  to 9  do Qwrite (WSrow+1+j,WScol+2,white+CyanBG,StrB[ j]);
  312.                        Qwrite (WSrow+12 ,WScol+2,          -1,StrB[11])
  313.   end;
  314. end;
  315.  
  316. procedure DisplayInitWindow;
  317. begin
  318.   { -- InitWindow description -- }
  319.   SetWindowModes (0);
  320.   MakeWindow (10,16,10,64,yellow+RedBG,yellow+RedBG,SingleBrdr,aWindow);
  321.   TitleWindow (Top,Left,' InitWindow ');
  322.   with TopWndwStat do
  323.   begin
  324.     for j:=1 to 2 do Qwrite (WSrow+1+j,WScol+2,cyan+RedBG ,StrC[j]);
  325.     for j:=3 to 6 do Qwrite (WSrow+1+j,WScol+2,white+RedBG,StrC[j]);
  326.   end;
  327. end;
  328.  
  329. procedure DisplaySetWindowModes;
  330. begin
  331.   { -- SetWindowModes description -- }
  332.   SetWindowModes (0);
  333.   MakeWindow (6,9,16,67,yellow+BlueBG,brown+BlueBG,HdoubleBrdr,aWindow);
  334.   TitleWindow (Top,Left,' SetWindowModes ');
  335.   with TopWndwStat do
  336.   begin
  337.     for j:=1 to  2 do Qwrite (WSrow+1+j,WScol+2,white+BlueBG,StrC1[j]);
  338.     for j:=3 to 12 do Qwrite (WSrow+1+j,WScol+2,           -1,StrC1[j]);
  339.   end;
  340. end;
  341.  
  342. procedure DisplayZoomMode;
  343. begin
  344.   { -- Zoom mode description -- }
  345.   SetWindowModes (ZoomMode);
  346.   MakeWindow (10,25,14,49,black+GreenBG,white+GreenBG,DoubleBrdr,aWindow);
  347.   TitleWindow (Top,Left,' ZoomMode Control ');
  348.   with TopWndwStat do
  349.   begin
  350.                      Qwrite (WSrow+2  ,WScol+2,white+GreenBG,StrC2[1]);
  351.     for j:=2 to 3 do Qwrite (WSrow+1+j,WScol+2,           -1,StrC2[j]);
  352.                      Qwrite (WSrow+6  ,WScol+2,white+GreenBG,StrC2[4]);
  353.     for j:=5 to 9 do Qwrite (WSrow+2+j,WScol+2,           -1,StrC2[j]);
  354.   end;
  355. end;
  356.  
  357. procedure DisplayMakeWindow;
  358. begin
  359.   { -- MakeWindow description -- }
  360.   SetWindowModes (0);
  361.   MakeWindow (5,6,20,72,lightmagenta+BlueBG,lightmagenta+BlueBG,SolidBrdr,
  362.               aWindow);
  363.   TitleWindow (Top,Left,' MakeWindow ');
  364.   with TopWndwStat do
  365.   begin
  366.     for j:=1 to  2 do Qwrite (WSrow+1+j,WScol+2,lightred+BlueBG,StrD1[j]);
  367.     for j:=3 to 16 do Qwrite (WSrow+1+j,WScol+2,yellow+BlueBG  ,StrD1[j]);
  368.   end;
  369. end;
  370.  
  371. procedure DisplayBorders;
  372. {}procedure MakePartitions;
  373. {}begin
  374. {}  PartitionWindow (Horiz   ,2);
  375. {}  PartitionWindow (Vertical,5);
  376. {}  PartitionCross  (       2,5);
  377. {}end;
  378. begin
  379.   { -- Display different borders -- }
  380.   SetWindowModes (0);
  381.   Battr:=yellow+GreenBG;
  382.   Wattr:=black+GreenBG;
  383.   MakeWindow (8,2,5,11,Wattr,Battr,Borders(NoBrdr),aWindow);
  384.   MakePartitions;
  385.   MakeWindow (11,8,5,11,Wattr,yellow+BrownBG,Borders(BlankBrdr),aWindow);
  386.   MakePartitions;
  387.   for i:=2 to 5 do
  388.     begin
  389.       MakeWindow (3*i-4,6*i-4,5,11,Wattr,Battr,Borders(i),aWindow);
  390.       MakePartitions;
  391.     end;
  392.   for i:=6 to 8 do
  393.     begin
  394.       MakeWindow (3*i-13,6*i-4,5,11,Wattr,Battr,Borders(i),aWindow);
  395.       MakePartitions;
  396.     end;
  397.   for i:=9 to 11 do
  398.     begin
  399.       MakeWindow (3*i-22,6*i-4,5,11,Wattr,Battr,Borders(i),aWindow);
  400.       MakePartitions;
  401.     end;
  402.   for i:=12 to 13 do
  403.     begin
  404.       MakeWindow (3*i-34,6*i-9,5,11,Wattr,Battr,Borders(i),aWindow);
  405.       MakePartitions;
  406.     end;
  407. end;
  408.  
  409. procedure DisplayPartitions;
  410. begin
  411.   { -- PartitionWindow description -- }
  412.   SetWindowModes (0);
  413.   MakeWindow (16, 8,10,68,lightgreen,lightgreen,SingleBrdr,aWindow);
  414.   TitleWindow (Top,Left,' PartitionWindow/PartitionCross ');
  415.   with TopWndwStat do
  416.   begin
  417.    for j:=1 to 2 do Qwrite (WSrow+1+j,WScol+2,yellow+BlackBG,StrD2[j]);
  418.    for j:=3 to 6 do Qwrite (WSrow+1+j,WScol+2,            -1,StrD2[j]);
  419.   end;
  420. end;
  421.  
  422. procedure DisplayRemoveWindow;
  423. begin
  424.   { -- RemoveWindow description -- }
  425.   SetWindowModes (0);
  426.   MakeWindow (11,22, 9,38,black+BrownBG,black+BrownBG,DoubleBrdr,
  427.               aWindow);
  428.   TitleWindow (Top,Left,' RemoveWindow ');
  429.   with TopWndwStat do
  430.   begin
  431.                      Qwrite (WSrow+2  ,WScol+2,yellow+BrownBG ,StrE[1]);
  432.     for j:=2 to 4 do Qwrite (WSrow+2+j,WScol+2,white+BrownBG  ,StrE[j]);
  433.   end;
  434. end;
  435.  
  436. procedure DisplayFlicker;
  437. begin
  438.   { -- Flicker Note -- }
  439.   SetWindowModes (ShadowRight);
  440.   MakeWindow (11,22, 4,40,black+BrownBG,black+BrownBG,HdoubleBrdr,
  441.               aWindow);
  442.   with TopWndwStat do
  443.     for j:=1 to 2 do
  444.       Qwrite (WSrow+j,WScol+2,-1,StrF[j]);
  445.   SetWindowModes (0);
  446. end;
  447.  
  448. procedure DisplayScrollWindow;
  449. begin
  450.   { -- ScrollWindow description -- }
  451.   TitleWindow (Top,Left,' ScrollWindow ');
  452.   with TopWndwStat do
  453.     begin
  454.       GotoRC (succ(WSrow),succ(WSCol));
  455.       for j :=1 to 17 do InsLine;
  456.       for j :=1 to 16 do
  457.         begin
  458.           ScrollWindow (1,18,up);
  459.           Qwrite (WSrow+17,WScol+1,-1,StrG[j])
  460.         end;
  461.     end;
  462. end;
  463.  
  464. procedure DisplayTitleWindow;
  465. begin
  466.   { -- TitleWindow description -- }
  467.   SetWindowModes (ZoomMode);
  468.   MakeWindow (12,16,10,56,black+LightGrayBG,red+LightGrayBG,EvenSolidBrdr,
  469.               aWindow);
  470.   TitleWindow (Top   ,Left  ,' TitleWindow ');
  471.   TitleWindow (Top   ,Center,' TitleWindow ');
  472.   TitleWindow (Top   ,Right ,' TitleWindow ');
  473.   TitleWindow (Bottom,Left  ,' TitleWindow ');
  474.   TitleWindow (Bottom,Center,' TitleWindow ');
  475.   TitleWindow (Bottom,Right ,' TitleWindow ');
  476.   with TopWndwStat do
  477.   begin
  478.     for j:=1 to 2 do Qwrite (WSrow+1+j,WScol+2,-1,StrH[j]);
  479.     for j:=3 to 5 do Qwrite (WSrow+2+j,WScol+2,-1,StrH[j]);
  480.   end;
  481. end;
  482.  
  483. procedure DisplayClearTitle;
  484. begin
  485.   { -- ClearTitle description -- }
  486.   ClearTitle (Bottom);
  487.   SetWindowModes (ZoomMode);
  488.   MakeWindow ( 9,21, 8,47,lightcyan+BlueBG,lightcyan+BlueBG,
  489.               HdoubleBrdr,aWindow);
  490.   TitleWindow (Top,Left,' ClearTitle ');
  491.   with TopWndwStat do
  492.   begin
  493.                      Qwrite (WSrow+2  ,WScol+2,yellow+BlueBG,StrH2[1]);
  494.     for j:=2 to 3 do Qwrite (WSrow+2+j,WScol+2,           -1,StrH2[j]);
  495.   end;
  496. end;
  497.  
  498. procedure DisplayClearWindow;
  499. begin
  500.   { -- ClearWindow description -- }
  501.   SetWindowModes (ZoomMode);
  502.   MakeWindow (15,13, 9,26,black+GreenBG,brown+GreenBG,
  503.               HhatchBrdr,aWindow);
  504.   TitleWindow (Top,Left,' ClearWindow ');
  505.   with TopWndwStat do
  506.   begin
  507.                      Qwrite (WSrow+2  ,WScol+2,yellow+GreenBG,StrH3[1]);
  508.     for j:=2 to 4 do Qwrite (WSrow+2+j,WScol+2,            -1,StrH3[j]);
  509.   end;
  510. end;
  511.  
  512. procedure DisplayMaxWndw;
  513. begin
  514.   { -- MaxWndw constant -- }
  515.   SetWindowModes (ZoomMode);
  516.   MakeWindow (17, 9, 8,38,black+BrownBG,black+BrownBG,NoBrdr,aWindow);
  517.   TitleWindow (Top,Center,'- WINDOW LIMITS -');
  518.   with TopWndwStat do
  519.     for j:=1 to 5 do Qwrite (WSrow+j+1,WScol+1,-1,StrJ[j]);
  520. end;
  521.  
  522. procedure DisplayQWIK40;
  523. begin
  524.   { -- QWIK40.TPU procedures -- }
  525.   SetWindowModes (ZoomMode);
  526.   MakeWindow (8,20,15,51,yellow+RedBG,yellow+RedBG,EvenSolidBrdr,aWindow);
  527.   TitleWindow (Top,Center,' QWIK Utilities ');
  528.   with TopWndwStat do
  529.   begin
  530.     for j:=1 to  2 do Qwrite (WSrow+1+j,WScol+2,         -1,StrK[j]);
  531.     for j:=3 to  8 do Qwrite (WSrow+2+j,WScol+2,white+RedBG,StrK[j]);
  532.     for j:=9 to 10 do Qwrite (WSrow+3+j,WScol+2,         -1,StrK[j])
  533.   end;
  534. end;
  535.  
  536. procedure DisplayProgramming;
  537. begin
  538.   { -- Programming for WNDW40.TPU -- }
  539.   SetWindowModes (ZoomMode);
  540.   MakeWindow (2,25,23,50,yellow+MagentaBG,yellow+MagentaBG,MhatchBrdr,aWindow);
  541.   TitleWindow (Top,Center,' Programming ');
  542.   with TopWndwStat do
  543.     for j:=1 to 20 do Qwrite (WSrow+1+j,WScol+2,-1,StrL[j]);
  544. end;
  545.  
  546. procedure DisplayEquipmentList;
  547. begin
  548.   { -- Compatible computers and adapters for WNDW40.TPU -- }
  549.   SetWindowModes (ZoomMode);
  550.   MakeWindow (4,35,17,34,black+BrownBG,black+BrownBG,HdoubleBrdr,aWindow);
  551.   TitleWindow (Top,Center,' Software Compatibility ');
  552.   with TopWndwStat do
  553.     for j:=1 to 15 do Qwrite (WSrow+j,WScol+2,white+BrownBG,StrM[j]);
  554. end;
  555.  
  556. procedure DisplayWndwMgrDemo;
  557. begin
  558.   { -- Prompt for next demo -- }
  559.   SetWindowModes (ZoomMode);
  560.   MakeWindow (6,29,13,36,white+GreenBG,yellow+GreenBG,ThinSolidBrdr2,aWindow);
  561.   TitleWindow (Top,Center,' Window Management Demo ');
  562.   with TopWndwStat do
  563.     for j:=1 to 9 do Qwrite (WSrow+j+1,WScol+2,-1,StrN[j]);
  564. end;
  565.  
  566. procedure DisplayAuthor;
  567. begin
  568.   { -- Author for WNDW40.TPU -- }
  569.   SetWindowModes (ZoomMode);
  570.   if VideoMode<>7 then
  571.     SetWindowModes (WindowModes+ShadowRight);
  572.   Brdr[UserBrdr2].BrdrArray:='┌┴┐┤├└┬┘┼─┼┼│┼┼';
  573.   MakeWindow (8,20,11,42,black+BrownBG,black+BrownBG,UserBrdr2,aWindow);
  574.   with TopWndwStat do
  575.     for j:=1 to 7 do
  576.       Qwrite (WSrow+1+j,WScol+2,white+BrownBG,StrO[j]);
  577.   TitleWindow (Bottom,Center,' Press RETURN to exit ');
  578. end;
  579.  
  580. procedure GetKey;
  581. var
  582.   ExtKey: boolean;
  583. begin
  584.   repeat
  585.     Key:=ReadKey;                        { Read keyboard input.      }
  586.     if KeyPressed and (Key=FuncKey) then { If first Char was #00 ... }
  587.       begin
  588.         Key:=ReadKey;                    { ... read second char.     }
  589.         ExtKey := true
  590.       end
  591.     else ExtKey:=false;
  592.   until (Key=RetKey) or (Key=EscKey);
  593. end;
  594.  
  595. procedure FindNextStep;
  596. begin
  597.   case Key of
  598.   EscKey: begin
  599.             if Step>Step0 then
  600.               begin
  601.                 RemoveWindow;
  602.                 case Step of
  603.                   Step5: for j:=1 to 13 do RemoveWindow;
  604.                   Step7: begin
  605.                            DisplayBorders;
  606.                            DisplayPartitions;
  607.                            DisplayRemoveWindow;
  608.                          end;
  609.                   Step8: Step:=Step4;
  610.                 end;  { case }
  611.                 dec (Step);
  612.               end
  613.             end;
  614.   RetKey: begin
  615.             inc (Step);
  616.             case Step of
  617.               Step7: for i:=1 to 16 do RemoveWindow;
  618.               Step8: RemoveWindow;
  619.             end
  620.           end;
  621.   end  { case }
  622. end;
  623.  
  624. procedure DisplayWindows;
  625. begin
  626.   repeat
  627.     GetKey;
  628.     FindNextStep;
  629.     if Key=RetKey then
  630.       case Step of
  631.         Step1:  DisplayGeneral;
  632.         Step2:  DisplayList;
  633.         Step3:  DisplayInitWindow;
  634.         Step3b: DisplaySetWindowModes;
  635.         Step3c: DisplayZoomMode;
  636.         Step4:  DisplayMakeWindow;
  637.         Step5:  DisplayBorders;
  638.         Step5b: DisplayPartitions;
  639.         Step6:  DisplayRemoveWindow;
  640.         Step7:  DisplayFlicker;
  641.         Step8:  DisplayScrollWindow;
  642.         Step9:  DisplayTitleWindow;
  643.         Step9b: DisplayClearTitle;
  644.         Step9c: DisplayClearWindow;
  645.        Step11:  DisplayMaxWndw;
  646.        Step12:  DisplayQWIK40;
  647.        Step13:  DisplayProgramming;
  648.        Step14:  DisplayEquipmentList;
  649.        Step15:  DisplayWndwMgrDemo;
  650.        Step16:  DisplayAuthor;
  651.       end;
  652.    until Step=Step17;
  653. end;
  654.  
  655. procedure CheckCursor;
  656. var CursorMode: integer absolute $0040:$0060;
  657. begin
  658.   if (ActiveDispDev=MdaMono) and (CursorMode=$0607) then
  659.     CursorChange($0C0D,OldCursor);
  660. end;
  661.  
  662. begin
  663.   InitWindow (blue+LightGrayBG,true);
  664.   CheckCursor;
  665.   CursorOff;
  666.   Display30windows;
  667.   DisplayInitialScreen;
  668.   DisplayWindows;
  669.   { -- Use the following statment to return to the original screen.-- }
  670.   for i:=1 to LI do RemoveWindow;
  671.   Qfill (1,1,25,CRTcols,TextAttr,' ');
  672.   QwriteC (12,1,CRTcols,TextAttr,'(c) 1986,1987  James H. LeMay');
  673.   QwriteC (13,1,CRTcols,TextAttr,'This concludes the windows tutorial...');
  674.   delay (2000);
  675.   NormVideo;
  676.   ClrScr;
  677.   CursorOn;
  678. end.
  679.